# ライブラリの読み込み
library(tidyverse)
library(magrittr)
library(ggplot2)
library(Hmisc)
library(DataExplorer)
library(lubridate)
library(data.table)
library(leaflet)
library(DT)
# tibbleのprintに関する設定
print.tbl_df <- print.data.frame
# パッケージの優先順位変更
unload_package <- function(pkg_name) {
packages <- Filter(function(x) stringr::str_detect(x, "^package:"), search())
packages <- Map(function(x) stringr::str_replace(x, "^package:", ""), packages)
packages <- unlist(unname(packages))
if(!(pkg_name %in% packages)) {
return(pkg_name)
}
result_packages <- pkg_name
while(TRUE) {
tryCatch({
detach(paste0("package:", pkg_name), character.only = TRUE)
break
}, error = function(e) {
required_package <- stringr::str_match(e$message, pattern = "required by ‘(.+?)’")[1, 2]
required_packages <- unload_package(required_package)
result_packages <<- c(result_packages, required_packages)
})
}
unique(result_packages)
}
prior_package <- function(pkg_name) {
pkg_name <- as.character(substitute(pkg_name))
pkg_names <- unload_package(pkg_name)
for (pkg_name in pkg_names) {
suppressPackageStartupMessages(library(pkg_name, character.only = TRUE))
}
}
prior_package(dplyr)
このレポートでは、KDD CUP 2019 (Regular ML)のデータについて、以下の確認を行った結果を記載しています。
事前知識
データの解析に役に立ちそうな背景知識についてまとめています。
具体的には、実際にBaidu Mapアプリの使った結果分かったことや、
北京の交通事情についてのネット上の記載をまとめています。
transport_modeの推定
transport_modeに関連するデータを探索的に解析し、
transport_modeがどの交通手段に対応しているか(ex:mode1はバスに対応している、等々)推定を行います。
最速・最短経路の影響
バス・地下鉄といった公共交通手段が複数レコメンドされた際、
候補内で最速・最短となる経路がどれだけクリックされやすくなるかを確認します。
目的地・移動経路の可視化
ユーザーがよく目的地として設定する地点や、
頻繁に検索される移動経路の可視化を行います。
このレポートの内容は、金曜日までに適宜修正していく可能性があります。
この章では、実際にBaidu Mapアプリの使った結果分かったことや、
北京の交通事情についてのネット上の記載をまとめています。
アプリ上で確認できた移動手段は以下の12種類
この内の11種類がtransport modeとなっている?
ただし、設置台数に対してメンテナンス費が足りず、故障しているものや汚れの激しいものもよくあるとのこと。
# あらかじめ距離に対する各交通方法の料金を算出する関数を作成する。
# 距離に対するバスの料金を算出する関数
f_bus_price <-
function(distance){
price =
ifelse(
distance<=10000,
200,
100*ceiling(distance/5000)
)
return(price)
}
# 距離に対するタクシーの料金を算出する関数
f_taxi_price <-
function(distance){
price =
ifelse(
distance<=3000,
1400,
230*ceiling((distance-3000)/1000)+1400
)
return(price)
}
# 距離に対する地下鉄の料金を算出する関数
f_subway_price <-
function(distance){
price =
map_dbl(
.x = distance,
.f = ~
if(.x<=6000){
return(300)
}else if(.x<=12000){
return(400)
}else if(.x<=22000){
return(500)
}else if(.x<=32000){
return(600)
}else{
min(100*ceiling((.x-32000)/20000)+600,1000)
}
)
return(price)
}
この章では、transport_modeに関連するデータを探索的に解析し、
transport_modeがどの交通手段に対応しているか推定を行います。
# #train_plans(レコメンド情報)の読み込み
#data_plans <- read_csv("data_set_phase1/train_plans.csv")
#
# #plansを処理しやすい形に変形
#
# distance <- data_plans$plans %>% str_extract_all("\"distance\":\\s\\d*") %>% map(~str_remove(.,"\"distance\":\\s")) %>% map(as.integer)
# price <- data_plans$plans %>% str_extract_all("\"price\":\\s\\d*") %>% map(~str_remove(.,"\"price\":\\s")) %>% map(as.integer)
# eta <- data_plans$plans %>% str_extract_all("\"eta\":\\s\\d*") %>% map(~str_remove(.,"\"eta\":\\s")) %>% map(as.integer)
# transport_mode <- data_plans$plans %>% str_extract_all("\"transport_mode\":\\s\\d*") %>% map(~str_remove(.,"\"transport_mode\":\\s")) %>% map(as.integer)
#
# df_plans<-
# pmap(
# .l = list(distance,price,eta,transport_mode),
# .f = ~data.frame(distance = ..1, price = ..2, eta = ..3, transport_mode = ..4)
# ) %>%
# map(~mutate(.,order = row_number()))
#
# data_plans %<>%
# select(-plans) %>%
# mutate(plan = df_plans) %>%
# unnest(plan)
# 前処理が重かったので念の為保存しておく
#data_plans %>% write_csv(path = "data_set_phase1/train_plans_r2.csv")
# train_plans(レコメンド情報), train_clicks(ユーザーの選択したtransport_mode)の読み込み----
data_plans <- fread("data_set_phase1/train_plans_r2.csv", stringsAsFactors=FALSE, sep=",")
data_clicks <- fread("data_set_phase1/train_clicks.csv", stringsAsFactors=FALSE, sep=",")
#data_t_plans のplan_timeのフォーマットをなおす
data_plans %<>% mutate(plan_time = ymd_hms(plan_time))
# transport_modeをfactorに変換
data_plans %<>% mutate(transport_mode = transport_mode %>% as.factor)
data_clicks %<>% mutate(click_mode = click_mode %>% as.factor)
# plan_timeの時間と、深夜フラグの追加
data_plans %<>%
mutate(hour = hour(plan_time)) %>%
mutate(flag_midnight = ifelse(hour<=4|hour>=23,1,0))
data_clicks %<>%
mutate(click_hour = hour(click_time)) %>%
mutate(flag_click_midnight = ifelse(click_hour<=4|click_hour>=23,1,0))
data_plans %>%
ggplot(
aes(x=transport_mode %>% as.factor,fill=transport_mode)
) +
geom_bar()
data_clicks %>%
ggplot(
aes(x=click_mode %>% as.factor,fill=click_mode)
) +
geom_bar()
data_plans %>%
ggplot(
aes(x=hour %>% as.factor,fill=transport_mode)
) +
geom_bar(position="fill")
data_clicks %>%
ggplot(
aes(x=click_hour %>% as.factor, fill=click_mode)
) +
geom_bar(position="fill")
data_plans %>%
ggplot(
aes(
x = price
)
) +
geom_histogram() +
facet_wrap(~ transport_mode,ncol=3,scales="free")
# densityとetaの関係
data_plans %>%
filter(!is.na(distance),!is.na(eta)) %>%
sample_n(size=100000) %>%
ggplot(
aes(
x = eta,
y = distance
)
) +
geom_point() +
facet_wrap(~ transport_mode,ncol=3)
# densityとpriceの関係(スケールフリー)
data_plans %>%
filter(!is.na(distance),!is.na(price)) %>%
sample_n(size=100000) %>%
ggplot(
aes(
x = distance,
y = price
)
) +
geom_point() +
facet_wrap(~ transport_mode,scales="free") +
stat_function(fun=f_bus_price,color="red") +
stat_function(fun=f_subway_price,color="green")
data_plans %>%
filter(transport_mode %in% c(1,7,11)) %>%
sample_n(size=100000) %>%
ggplot(
aes(
x = distance,
y = price
)
) +
geom_point() +
facet_wrap(~transport_mode,ncol=1) +
stat_function(fun = f_bus_price,color="red") +
stat_function(fun = f_subway_price,color="green") +
xlim(0,150000) +
ylim(0,5000)
緑線:ネットで調べた地下鉄の料金
よってmode1 = バス, mode7 = バス&地下鉄, mode11 = バス&自転車 か?
data_plans %>%
filter(transport_mode %in% c(2,9)) %>%
sample_n(size=100000) %>%
ggplot(
aes(
x = distance,
y = price
)
) +
geom_point() +
facet_wrap(~transport_mode,ncol=1) +
stat_function(fun = f_subway_price,color="green")
# densityとpriceの関係(スケールフリー)
data_plans %>%
filter(!is.na(distance),!is.na(price)) %>%
sample_n(size=100000) %>%
ggplot(
aes(
x = distance,
y = price
)
) +
geom_point() +
facet_wrap(~ transport_mode,scales="free") +
stat_function(fun=f_taxi_price,color="blue")
| mode | 推測結果 | 根拠 |
|---|---|---|
| 1 | バス | ・ネットで調べたバス料金と当てはまりが良い ・clicksの出現回数が多い |
| 2 | 地下鉄 | ・ネットで調べた地下鉄料金と当てはまりが良い ・clicksの出現回数が多い |
| 3 | 車 | ・priceがないmodeの中で最も移動速度が早い |
| 4 | タクシー | ・最も料金が高い ・ネットで調べたタクシー料金と最も当てはまりが良い |
| 5 | 徒歩 | ・priceがないmodeの中で最も移動速度が遅い |
| 6 | 自転車 | ・priceがないmodeの中で二番目に移動速度が早い |
| 7 | バス&地下鉄 | ・ネットで調べたバス料金と当てはまりが良い ・バス料金と地下鉄料金の中間となっているplansが多い |
| 8 | 不明 | ・(地下鉄&タクシー) or (バス&タクシー) or (配車アプリ)のどれかか? |
| 9 | 地下鉄&自転車 | ・ネットで調べた地下鉄料金+100RMB程度となっていることが多い |
| 10 | 不明 | ・(地下鉄&タクシー) or (バス&タクシー) or (配車アプリ)のどれかか? |
| 11 | バス&自転車 | ・ネットで調べたバス料金と当てはまりが良い ・バスのみ利用 or バス&地下鉄は他のmodeに割り当てられていると推測 ・バス&タクシーにしては料金が高すぎるので、消去法でバス&自転車と推測 |
この章では、バス・地下鉄といった公共交通手段が複数レコメンドされた際、
候補内で最速・最短となる経路がどれだけクリックされやすくなるかを確認します。
あるplanで、以下の内から複数のmodeがレコメンドされ、どれかがclickされたケースを考える。
# バスor地下鉄と推測されるtransport_modeのリストを作る
mode_bus_or_subway = c(1,2,7,9,11)
#各sidごとに最速・最安経路となるsidを抜き出す
data_plans_fastest <-
data_plans %>%
filter(transport_mode %in% mode_bus_or_subway) %>%
group_by(sid) %>%
filter(eta == min(eta)) %>%
ungroup %>%
select(sid,transport_mode) %>%
mutate(flag_fastest = 1)
data_plans_lowest <-
data_plans %>%
filter(transport_mode %in% mode_bus_or_subway) %>%
group_by(sid) %>%
filter(price == min(price)) %>%
ungroup %>%
select(sid,transport_mode) %>%
mutate(flag_lowest = 1)
# plansの中からバスor地下鉄が選択されたsidを抽出
data_clicks_bus_or_subway <-
data_clicks %>%
filter(click_mode %in% mode_bus_or_subway) %>%
select(sid,click_mode) %>%
mutate(flag_click = 1)
# plansからバス・地下鉄のみを抜き出し、最安・最短フラグをつける
data_plans_bus_of_subway <-
data_plans %>%
filter(transport_mode %in% mode_bus_or_subway) %>%
inner_join(data_clicks_bus_or_subway %>% select(sid),by="sid") %>%
group_by(sid) %>%
filter(n() >= 2) %>%
ungroup %>%
left_join(data_clicks_bus_or_subway,by=c("sid","transport_mode"="click_mode")) %>%
select(sid,transport_mode,flag_click) %>%
distinct() %>%
left_join(data_plans_fastest,by=c("sid","transport_mode")) %>%
left_join(data_plans_lowest ,by=c("sid","transport_mode")) %>%
replace_na(list(flag_click = 0, flag_fastest = 0, flag_lowest = 0)) %>%
mutate(flag_fast_and_low = str_c(flag_fastest,"-",flag_lowest)) %>%
mutate_at(.vars = vars(starts_with("flag_"),"transport_mode"),.funs = as.factor)
# 最速・最安フラグ別 clickの割合
data_plans_bus_of_subway %>%
ggplot(
aes(x=flag_fast_and_low,fill=flag_click)
) +
geom_bar(position="fill")
flag_fast_and_lowの意味は以下の通り
flag_clickの意味は以下の通り
data_plans_bus_of_subway %>%
ggplot(
aes(x=flag_fast_and_low,fill=flag_click)
) +
geom_bar(position="fill") +
facet_wrap(~transport_mode)
data_plans_bus_of_subway %>%
ggplot(
aes(x=flag_fast_and_low,fill=flag_click)
) +
geom_bar() +
facet_wrap(~transport_mode)
この章では、ユーザーがよく目的地として設定する地点や、
頻繁に検索される移動経路の可視化を行います。
# train_queries の読み込み----
data_queries <- fread("data_set_phase1/train_queries.csv", stringsAsFactors=FALSE, sep=",")
# 目的地の緯度経度ごとのカウント数
data_queries_d <-
data_queries %>%
group_by(d) %>%
summarise(count=n()) %>%
ungroup() %>%
arrange(desc(count)) %>%
separate(col=d,into=c("lng","lat"),sep=",") %>%
mutate(lng=lng %>% as.numeric,lat=lat %>% as.numeric) %>%
mutate(log10_count = log10(count))
#カウント別カラー用のパレットの作成
pal_d <- colorNumeric(palette="Spectral", domain=data_queries_d$log10_count, reverse=TRUE)
# 地図の作成
data_queries_d %>%
leaflet() %>%
addTiles() %>%
addCircles(lng=~lng,lat=~lat,color=~pal_d(log10_count),radius=500,stroke=FALSE,fillOpacity = 0.6) %>%
addLegend(position='topright', pal=pal_d, values=~log10_count) %>%
addScaleBar(position="bottomleft",options = scaleBarOptions(imperial=FALSE))
# 移動経路ごとのカウント数
data_queries_od <-
data_queries %>%
group_by(o,d) %>%
summarise(count=n()) %>%
ungroup() %>%
arrange(desc(count)) %>%
separate(col=o,into=c("o_lng","o_lat"),sep=",") %>%
separate(col=d,into=c("d_lng","d_lat"),sep=",") %>%
mutate(
o_lng=o_lng %>% as.numeric,
o_lat=o_lat %>% as.numeric,
d_lng=d_lng %>% as.numeric,
d_lat=d_lat %>% as.numeric
) %>%
mutate(log10_count = log10(count)) %>%
head(300)
# カウント別カラー用のパレットの作成
pal_od <- colorNumeric(palette="Spectral", domain=data_queries_od$log10_count, reverse=TRUE)
# 地図の作成
plot_queries_od <-
leaflet() %>%
addTiles() %>%
addLegend(position='topright', pal=pal_od, values=data_queries_od$log10_count) %>%
addScaleBar(position="bottomleft",options = scaleBarOptions(imperial=FALSE))
for(i in 1:300){
o_p <- data_queries_od %>% filter(row_number() == i) %>% select(o_lng,o_lat,count,log10_count) %>% rename(lng=o_lng,lat=o_lat)
d_p <- data_queries_od %>% filter(row_number() == i) %>% select(d_lng,d_lat,count,log10_count) %>% rename(lng=d_lng,lat=d_lat)
od_p <- union(o_p,d_p)
plot_queries_od %<>% addPolylines(lng=od_p$lng,lat=od_p$lat,color=pal_od(od_p$log10_count),weight="5")
}
plot_queries_od
# 移動経路をclick_mode別にプロットする
# data_queriesとdata_clicksを結合
data_queries_mode <-
data_queries %>%
inner_join(data_clicks,by="sid")
num_lines = 1000
# 移動経路の緯度経度(念の為countを出しておく)
data_queries_od_mode <-
data_queries_mode %>%
group_by(o,d,click_mode) %>%
summarise(count=n()) %>%
ungroup() %>%
arrange(desc(count)) %>%
separate(col=o,into=c("o_lng","o_lat"),sep=",") %>%
separate(col=d,into=c("d_lng","d_lat"),sep=",") %>%
mutate(
o_lng=o_lng %>% as.numeric,
o_lat=o_lat %>% as.numeric,
d_lng=d_lng %>% as.numeric,
d_lat=d_lat %>% as.numeric
) %>%
mutate(log10_count = log10(count)) %>%
sample_n(size=num_lines)
pal <- colorFactor(palette="Spectral",domain=data_queries_od_mode$click_mode)
plot_queries_od_mode <-
leaflet() %>%
addTiles() %>%
addLegend(position='topright', pal=pal, values=data_queries_od_mode$click_mode) %>%
addScaleBar(position="bottomleft",options = scaleBarOptions(imperial=FALSE))
for(i in 1:num_lines){
mode <- data_queries_od_mode %>% filter(row_number() == i) %>% .$click_mode
o_p <- data_queries_od_mode %>% filter(row_number() == i) %>% select(o_lng,o_lat,click_mode,log10_count) %>% rename(lng=o_lng,lat=o_lat)
d_p <- data_queries_od_mode %>% filter(row_number() == i) %>% select(d_lng,d_lat,click_mode,log10_count) %>% rename(lng=d_lng,lat=d_lat)
od_p <- union(o_p,d_p)
plot_queries_od_mode %<>% addPolylines(lng=od_p$lng,lat=od_p$lat,color=pal(od_p$click_mode),weight="3",group=mode %>% as.character)
}
plot_queries_od_mode %>%
addLayersControl(
overlayGroups=1:11 %>% as.character,
options=layersControlOptions(collapsed = FALSE)
)
data_plans %>% filter(sid==1081113)
# sid plan_time distance price eta transport_mode order
# 1 1081113 2018-11-08 13:42:49 1153 NA 1046 5 1
# 2 1081113 2018-11-08 13:42:49 1357 NA 409 6 2
# 3 1081113 2018-11-08 13:42:49 2026 NA 423 3 3
# 4 1081113 2018-11-08 13:42:49 2026 1300 663 4 4
# 5 1081113 2018-11-08 13:42:49 1773 200 1164 1 5
# 6 1081113 2018-11-08 13:42:49 1713 200 1575 1 6
# hour flag_midnight
# 1 13 0
# 2 13 0
# 3 13 0
# 4 13 0
# 5 13 0
# 6 13 0
作成中。。。
# # ユーザー特徴
#data_profiles <- read_csv("data_set_phase1/profiles.csv")
#data_profiles %>% create_report(output_file = "data_profiles_report.html", output_dir = "create_report")
# 北京の気候データの読み込み
climate <- read_csv("data_set_phase1/climate.csv")
climate %<>%
mutate(
date = ymd(str_c(year,month,day))
) %>%
select(-year,-month,-day)
# 北京の気温をプロット
climate %>%
select(-precipitation) %>%
gather(key = key, value = value,-date) %>%
ggplot(aes(x=date,y=value,color=key)) +
geom_line()
# 北京で降水のあった日を確認
climate %>%
select(date,precipitation) %>%
filter(precipitation > 0.0) %>%
print
# date precipitation
# 1 2018-10-15 4.0
# 2 2018-11-04 0.7
# 3 2018-12-01 0.2